package Code::Profile;

use strict;
use warnings;
use File::Slurp;
use File::Path;
use HTML::Entities;


our $VERSION = '0.01';


use base qw(Class::Accessor::Complex Class::Accessor::Constructor);


__PACKAGE__
    ->mk_constructor
    ->mk_scalar_accessors(qw(profile report_dir))
    ->mk_hash_accessors(qw(summary));


use constant DEFAULTS => (
    report_dir => 'profile_html',
);


sub html_header { shift; sprintf <<'EOHTML', @_ };
<?xml version="1.0" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>%s</title>
<meta http-equiv="content-type" content="text/html; charset=utf-8" />
</head>

<style type="text/css">
<!--
/* default style sheet generated by perltidy */
body {background: #FFFFFF; color: #000000}
pre { color: #000000; 
      background: #F0F0F0;
      font-family: courier;
    } 

.normal { color: #888888; }
.l01   { color: #777777; }
.l02   { color: #666666; }
.l03   { color: #555555; }
.l04   { color: #444444; }
.l05   { color: #333333; }
.l06   { color: #222222; }
.l07   { color: #111111; }
.l08   { color: #000000; }

-->
</style>

<body style="background-color: white">
<pre>
EOHTML


sub html_footer { <<'EOHTML' }
</pre>
</body>
</html>
EOHTML


sub html_write_line {
    my ($self, $line, $class) = @_;
    1 while chomp $line;
    sprintf qq!<span class="%s">%s</span>\n!,
        $class,
        encode_entities($line);
}


sub profiled_filename_for {
    my ($self, $filename)  = @_;

    # remove leading slash and turn the other slashes into dashes
    $filename .= '.html';
    $filename =~ s!^/!!;
    $filename =~ s!/!-!g;
    $filename;
}


sub write_report_for_file {
    my ($self, $filename, $text) = @_;

    mkdir $self->report_dir;
    $filename =
        $self->report_dir . '/' . $self->profiled_filename_for($filename);
    open my $fh, '>', $filename or die "can't open $filename for writing: $!\n";
    print $fh $text;
    close $fh or die "can't close $filename: $!\n";
}


sub summary_html_header { <<EOHTML }
<?xml version="1.0" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Summary</title>
<meta http-equiv="content-type" content="text/html; charset=utf-8" />
</head>
<body style="background-color: white">
<ul>
EOHTML


sub summary_html_footer { <<'EOHTML' }
</ul>
</body>
</html>
EOHTML


sub summary_write_line_for {
    my ($self, $filename) = @_;
    sprintf qq!<li><a href="%s">%s</a></li>\n! =>
        $self->profiled_filename_for($filename), $filename;
}


sub should_skip {
    my ($self, $line) = @_;
    $line =~ /^\* file name/;
}


sub classify {
    my ($filename, $line, $count, $time, $ctime) = @_;
    return 'l07' if $count > 1;
    return 'l04' if $count == 1;
    'normal';
}


sub process {
    my $self = shift;
    my @profile = read_file($self->profile);
    my %result;
    for my $profile (@profile) {
        next if $self->should_skip($profile);
        my @data = split /:/ => $profile;
        my $class = $self->classify(@data);
        my ($filename, $line) = @data[0,1];
        $result{$filename}{$line} = { class => $class, data => \@data };
    }


    for my $filename (keys %result) {
        my @file_contents = read_file($filename);
        my $html = $self->html_header($filename);
        my $i = 1;
        for my $file_line (@file_contents) {
            my $class = $result{$filename}{$i}{class} || 'normal';
            $html .= $self->html_write_line($file_line, $class);
            $i++;
        }
        $html .= $self->html_footer;
        $self->write_report_for_file($filename, $html);
    }

    my $summary_html = $self->summary_html_header;
    for my $filename (sort keys %result) {
        $summary_html .= $self->summary_write_line_for($filename);
    }
    $summary_html .= $self->summary_html_footer;
    $self->write_report_for_file('profile', $summary_html);
}


1;


__END__

{% USE p = PodGenerated %}

=head1 NAME

Code::Profile - FIXME

=head1 SYNOPSIS

    my $o = Code::Profile->new;

=head1 DESCRIPTION

FIXME

=head1 METHODS

=over 4

{% p.write_methods %}

=back

{% p.write_inheritance %}

{% PROCESS standard_pod %}

=cut

